/*
 * Funny Language - a free style programming language.
 * Copyright (C) 2015 by fanguangping (fanguangping@163.com)
 * list.c
 */

#include "../basic/operator.h"

//将链表反序
Cell* reverse(Scheme *sc, Cell* old_list) {
	Cell* new_list = G_NIL;
	for (; type_of(sc, old_list, PAIR_TYPE); old_list = cdr(old_list)) {
		new_list = cons(sc, car(old_list), new_list);
	}
	return new_list;
}

//list* ,例子 (list* 1 2 3) => (1  2 . 3)
Cell* list_star(Scheme *sc, Cell* old_list) {
	old_list = reverse(sc, old_list);
	Cell* new_list = car(old_list);
	old_list = cdr(old_list);
	while (type_of(sc, old_list, PAIR_TYPE)) {
		new_list = cons(sc, car(old_list), new_list);
		old_list = cdr(old_list);
	}
	return new_list;
}

/* append list -- produce new list (in reverse order) */
//如果acc 为 (4 3) ,  list 为 (5 6) , 则最后返回结果应当为 (6 5 4 3)
Cell* revappend(Scheme *sc, Cell* acc, Cell* list) {
	while (type_of(sc, list, PAIR_TYPE)) {
		acc = cons(sc, car(list), acc);
		list = cdr(list);
	}
	if (list == G_NIL)
		return acc;
	return G_FALSE; /* signal an error */
}

/* Result is:
 proper list: length
 circular list: -1			//环行链表
 not even a pair: -2	//如果是这样的形式(a . b) （b不是pair）
 dotted list: -2 minus length before dot	//pair 链表的最后一个cell不是nil
 */
int ls_length(Scheme *sc, Cell* a) {
	int len = 0;
	Cell* slow = a;
	Cell* fast = a;
	while (TRUE) {
		if (fast == G_NIL)
			return len;
		if (!type_of(sc, fast, PAIR_TYPE))
			return -2 - len;
		fast = cdr(fast);
		++len;
		if (fast == G_NIL)
			return len;
		if (!type_of(sc, fast, PAIR_TYPE))
			return -2 - len;
		fast = cdr(fast);
		++len;
		slow = cdr(slow);
		//如果a中有一个环 fast 和slow都会最终进入这个环中，并且有于fast是slow的速度的两倍，索引fast最终能赶上slow
		if (fast == slow)
			return -1;
	}
}

int is_list(Scheme *sc, Cell* a) {
	return ls_length(sc, a) >= 0;
}

// (reverse LIST)
Cell* op_reverse(Scheme *sc) {
	sc->returnValue = reverse(sc, first(sc->args));
	return pop_callstack(sc);
}

// (list* 1 2 3) => (1  2 . 3)
Cell* op_list_star(Scheme *sc) {
	sc->returnValue = list_star(sc, sc->args);
	return pop_callstack(sc);
}

// (append LIST LIST)
Cell* op_append(Scheme *sc) {
	Cell* x, *y;
	x = G_NIL;
	y = sc->args;
	while (y != G_NIL) {
		x = revappend(sc, x, car(y));
		y = cdr(y);
		if (x == G_FALSE) {
			sc->returnValue = make_default_exception(sc, "NON_LIST_ARGUMENT", "non-list argument to append.");
			return pop_callstack(sc);
		}
	}
	sc->returnValue = reverse(sc, x);
	return pop_callstack(sc);
}


// (length LIST)
Cell* op_list_length(Scheme *sc) {
	long len = ls_length(sc, first(sc->args));
	if (len < 0) {
		sc->returnValue = make_default_exception(sc, "NOT_A_LIST", "length: not a list.");
		return pop_callstack(sc);
	}
	sc->returnValue = make_integer(sc, len);
	return pop_callstack(sc);
}

// (assq object alist)
// (define e '((a 1) (b 2) (c 3)))
// (assq 'a e)  =>  (a 1)
Cell* op_assq(Scheme *sc) {
	Cell* x, *y;
	x = car(sc->args);
	for (y = cadr(sc->args); type_of(sc, y, PAIR_TYPE); y = cdr(y)) {
		if (!type_of(sc, car(y), PAIR_TYPE)) {
			sc->returnValue = make_default_exception(sc, "NON_PAIR_ELEMENT", "unable to handle non pair element.");
			return pop_callstack(sc);
		}
		if (x == caar(y))
			break;
	}
	if (type_of(sc, y, PAIR_TYPE))
		sc->returnValue = car(y);
	else
		sc->returnValue = G_FALSE;
	return pop_callstack(sc);
}

void init_list_operators(Scheme *sc) {
	ADD_OPERATOR(sc, "reverse", reverse);
	ADD_OPERATOR(sc, "list*", list_star);
	ADD_OPERATOR(sc, "append", append);
	ADD_OPERATOR(sc, "length", list_length);
	ADD_OPERATOR(sc, "assq", assq);
}
